 PAG
********************
* SFIVEFONE
********************

 ORG $C800

COMMANDS
* SEGMENT 0
 ASC "RTTREXERTSDR"

* SEGMENT 1
 ASC "P=PCA=X=Y=S=GOSBHBRBRHRAMMMDM ? JS"

* SEGMENT 2
 ASC "ONOFMOQU* **"

* SEGMENT 3
 ASC "MA"

* SEGMENT 4
 ASC "> KESSSDMWPW"

* SEGMENT 5
 ASC "L LIET"

* COMMAND ADDRESS TABLE

* THE FOLLOWING COMMANDS ARE IN SEGMENT 0

COMDJUMP
 DA COMDRT-1
 DA COMDTR-1
 DA COMDEX-1
 DA COMDER-1
 DA COMDTS-1
 DA COMDDR-1

* THE FOLLOWING COMMANDS ARE IN SEGMENT 1

CMNDSEG1
 DA COMDDOTP-1
 DA COMDPC-1
 DA COMDPA-1
 DA COMDPX-1
 DA COMDPY-1
 DA COMDPS-1
 DA COMDGO-1
 DA COMDSB-1
 DA COMDHB-1
 DA COMDRB-1
 DA COMDRH-1
 DA COMDRA-1
 DA COMDMM-1
 DA COMDMD-1
 DA CMDMENU-1
 DA CMDMENU-1
 DA COMDJS-1

* THE FOLLOWING COMMANDS ARE IN SEGMENT 2

CMNDSEG2
 DA COMDON-1
 DA COMDOFF-1
 DA COMDMO-1
 DA COMDQU-1
 DA COMDAST-1
 DA COMDAST-1

* THE FOLLOWING COMMANDS ARE IN SEGMENT 3

CMNDSEG3
 DA COMDMA-1

* THE FOLLOWING COMMANDS ARE IN SEGMENT 4

CMNDSEG4
 DA COMDSKIP-1
 DA COMDKEY-1
 DA COMDSS-1
 DA COMDSD-1
 DA COMDMW-1
 DA COMDPW-1

* THE FOLLOWING COMMANDS ARE IN SEGMENT 5

CMNDSEG5
 DA COMDLI-1
 DA COMDLI-1
 DA COMDET-1

MSGVERS
 DFB CR,CR,CR,CR
 ASC "          (R)"
 DFB CR
 ASC " --- ProDev  DDT8 Version 1.6.1 ---"
 DFB CR,CR
 ASC "    28-May-2005     16:42 pm"
 DFB CR,CR
 ASC "         BY: Chuck Kelly"
 DFB CR,CR,CR,CR,CR,CR,CR,CR,CR
* ASC "      Christ is the answer!" 
* Amazing how many people were afraid of this statement.
* Unfortunately for them their fears do not change reality.
 DFB CR,CR,CR,CR,CR,CR
 DFB EOT


* Copyright message for displaying in break window

MSGCOPYR
 DFB CR,CR,CR
 ASC "This program"
 DFB CR
 ASC "released to"
 DFB CR
 ASC "Public Domain"
 DFB CR
 ASC "      by:"
 DFB CR
 ASC "  ProDev, Inc"
 DFB CR,CR
 ASC "  No rights"
 DFB CR
 ASC "   reserved"
 DFB CR,CR,EOT


* MESSAGE FOR EXECUTION TIME

MSGET EQU *
 ASC "CLOCK CYCLES = $"
 DFB EOT

*--------------------
* MSGCRES

MSGCRES
 DFB CR
 ASC "(return,esc) ?"
 DFB EOT

****************************************
* THIS POINT MUST BE $CA00 OR ABOVE.
****************************************

 DS $CA00-*,$FF

******************************
* PUT ADDRESS OF COMMAND ON STACK
* RETURNS WITH CARRY CLEAR IF COMMAND IS IN SEG 0
******************************

GETCOMD
 LDA TFLAG ;is Trace mode active?
 BNE GETCOM ;If yes, skip <CR>
 JSR TRANSFR5 ;DO <CR>
 DFB CROUTC  ;code

 LDA #":"  ;LOAD ACC WITH ASCII ":"
 STA PROMPT  ;STORE PROMPT

GETCOM JSR TRANSFR5 ;GET INPUT LINE NO <CR>
 DFB GETLNC  ;CODE BYTE
 BCS GETCOMD ;if <esc> key pressed

* ASSUMES X=0 IF ONLY A RETURN IS ENTERED
 INX   ;INC. CHAR. COUNT
 LDY #00  ;CLEAR Y
 JSR TRANSFR5 ;GET CHAR
 DFB GETCHRC  ;CODE BYTE
 BNE :GETC  ;GET THE COMMAND

*ONLY A CR WAS ENTERED SO CHECK TRACE FLAG
 LDA TFLAG
 BEQ GETCOM ;IF TFLAG NOT SET
 JSR TRANSFR5 ;do TRACE1 (does not return)
 DFB TRACE1C ;code

:GETC STA LETTER1
 LDA IN,Y  ;GET NEXT LETTER OF COMMAND
 INY
 DEX   ;SETS ZFLAG WHEN BUFFER EMPTY
 BNE :LTR2
 LDA #$A0  ;ONLY ONE LETTER WAS ENTERED SO

* FILL WITH SPACE IN CASE IT WAS A SINGLE LETTER COMMAND
 INX
 DEY   ;POINT AT CR SO GETCHR0 WORKS IN LIST ROUTINE
:LTR2 STA LETTER2
 STX XBUFF
 LDX #COMDJUMP-COMMANDS-2 ;# OF COMMAND LETTERS - 1
:CHECK LDA LETTER1
 CMP $C800  ;DISABLE EXT RAM
 CMP COMMANDS,X
 STA $CF00  ;ENABLE EXT RAM
 BNE :NEXT  ;NO MATCH

 INX   ;LOOK AT SECOND LETTER OF COMMAND
 LDA LETTER2
 CMP $C800  ;DISABLE EXT RAM
 CMP COMMANDS,X ;DO THEY MATCH
 BEQ :FOUND  ;IF YES
 CMP $CF00  ;ENABLE EXT RAM
 DEX

:NEXT DEX   ;TRY NEXT COMMAND
 DEX
 BPL :CHECK

 STA $CF00  ;ENABLE EXT RAM
 LDA #INVCOM  ;INVALID COMMAND ERROR NUMBER
 JSR ERRBEEP
 JMP GETCOMD

:FOUND LDA COMDJUMP,X ;push command address for RTS
 PHA
 LDA COMDJUMP-1,X
 PHA
 CMP $CF00  ;ENABLE EXT RAM

 LDA #0
 STA TFLAG  ;CLEAR TFLAG
 CPX #CMNDSEG1-COMDJUMP ;IS COMMAND IN SEG 0 ?
 BLT :TOSEG0  ;yes
 CPX #CMNDSEG2-COMDJUMP ;IS COMMAND IN SEG 1?
 BLT :TOSEG1  ;YES
 CPX #CMNDSEG3-COMDJUMP ;IS COMMAND IN SEG 2?
 BLT :TOSEG2  ;IF YES
 CPX #CMNDSEG4-COMDJUMP ;IS COMMAND IN SEG 3
 BLT :TOSEG3  ;IF YES
 CPX #CMNDSEG5-COMDJUMP ;IS COMMAND IN SEG 4 ?
 BGE :SEG5  ;IF no, must be seg 5
 LDA #04 ;seg 4
 BNE :JUMPSG
:TOSEG3 LDA #3
 BNE :JUMPSG
:TOSEG2 LDA #2
 BNE :JUMPSG
:TOSEG1 LDA #01  ;SET ACC FOR SEGMENT 1
 BNE :JUMPSG
:TOSEG0 LDA #0
:JUMPSG STA TEMP  ;SEG # OF COMMAND
 CLC   ;NOT SEG 5
:SEG5 PHP   ;SAVE CARRY
 LDX XBUFF  ;RESTORE
 JSR TRANSFR5 ;GET NEXT CHARACTER
 DFB GETCHRC  ;code
* STA LETTER1  ;SAVE
 PLP   ;GET CARRY

 INX
 DEX  ;SET Z BIT BY X
 BCS :STAY5 ;COMMAND IN SEG 5
 JSR SAVEAXP5 ;SAVE REGISTERS
 JMP JUMPSEG5 ;GO TO THE COMMAND IN SEG 0,1,2,3 or 4

:STAY5 RTS   ;USE RTS TO PULL ADDRESS AND GO TO COMMAND

*------------------------------
* DISPLAY VERSION NUMBER

DISVERS

 JSR WRINIT5
:MORE LDA MSGVERS,Y ;GET CHAR
 JSR WRITECK5 ;DISPLAY
 BCC :MORE  ;<ALWAYS>

* SET CARRY FLAG IF RETURNING TO USER AFTER INIT.

:DONE BIT STRT2FLG ;DID WE ENTER AT START2 ?
 BMI :ENTER  ;IF NO, ENTER EXT II

 JSR TRANSFR5 ;RESTORE TEXT
 DFB RESTTEXTC ;code

 LDA #$FF
 STA STRT2FLG ;RESET FLAG
 STA VIAIFR  ;DISABLE OLD INTERRUPT FLAGS
 LDA #%10000010 ;ENABLE BUTTON ONLY
 STA VIAIER

* Check for condition #2 return.
 LDA ACC  ;get contents of accumulator at entry
 CMP #2  ;was condition #2 selected ?
 BNE :CK3  ;if no
* Set return condition #2, button & BRKs not enabled, writing to card is
* allowed, accessing vectors is OK.
 LDA #%00000010 ;Disable button
 STA VIAIER
 LDA #%11111110 ;CB2 HI, CB1 POS EDGE, CA2 HI, CA1 NEG EDGE
 BNE :RTSET  ;<ALWAYS>

* Check for condition #3 return.
:CK3 CMP #3  ;was condition #3 selected ?
 BNE :DEFALT  ;if no
* Set return condition #3, button is only way back into card.
* accessing vectors is OK, card is write protected.
 LDA #%11011100 ;CB2 LOW, CB1 POS EDGE, CA2 LOW, CA1 NEG EDGE
 BNE :RTSET  ;<ALWAYS>

* Set default return condition, button, BRKs, writing to card all enabled
* accessing vectors $FFE8-$FFFF turns on /INH flip-flop.
:DEFALT LDA #%11011110 ;CB2 LOW, CB1 POS EDGE, CA2 HI, CA1 NEG EDGE

:RTSET SEC
 RTS

:ENTER CLC
 RTS

*---------------------------------
*  Display the copyright notice in the breakpoint window

COPYR JSR TRANSFR5 ;display the break window to set the window
 DFB DISBRKWC ;code

 JSR WRINIT5
:MORE LDA MSGCOPYR,Y ;GET CHAR
 JSR WRITECK5 ;DISPLAY
 BCC :MORE  ;<ALWAYS>

 JSR TRANSFR4 ;set DR window
 DFB WINDDRC  ;code
 RTS

*----------------------------------
* Write text to the display device

WRINIT5 STY YBUFF  ;SAVE
 LDY #0
WRITMOR5
 BIT $C800  ;DISABLE EXT RAM
 CLC
 RTS
* This point must be before $CF00
 ERR */$CF00
WRITECK5
 BIT $CF00  ;ENABLE EXT RAM
 INY   ;NEXT CHARACTER
 CMP #EOT  ;FINISHED?
 BEQ WRITDON5 ;IF YES, CARRY ALSO SET
 JSR TRANSFR5 ;DISPLAY CHARACTER
 DFB COUTC  ;CODE
 JMP WRITMOR5
WRITDON5
 LDY YBUFF  ;RESTORE
 RTS

********************************
*  COMDL - LIST
********************************

COMDLI EQU *
 BEQ :CONT  ;IF NO ADDRESS FOLLOWS
 JSR TRANSFR5 ;GET ADDRESS
 DFB LOADMEMC ;CODE
 BCC :CONT  ;GOOD ADDRESS SO CONTINUE
 LDA #BADPAR  ;ERROR NUMBER
 BNE TOERR5  ;<ALWAYS>
:CONT

***** DISASSEMBLE AND LIST 20 LINES OF THE PROGRAM

LIST LDA #20  ;20 LINES
:NEXT PHA   ;SAVE

* ON RETURN NUMDISP =# OF BYTES IN INSTRUCTION - 1

 JSR TRANSFR5 ;LIST 1 LINE
 DFB DISASMC  ;code
 SEC
 LDA NUMDISP
 ADC MEMLOW
 STA MEMLOW
 LDA MEMHI  ;INC MEMORY POINTER
 ADC #0
 STA MEMHI
 PLA
 SEC
 SBC #1  ;DECREMENT COUNTER
 BEQ :END  ;IF FINISHED
 LDX MLIFLAG  ;WAS THE LAST INST. AN MLI CALL
 BNE :NEXT  ;IF NO
 SBC #1  ;COMPENSATE FOR XTRA LINE OF MLI
 BNE :NEXT

:END JMP GETCOMD

********************************
*  COMDET
********************************

COMDET EQU *
 BEQ BPERR5  ;NO ADDRESS FOLLOWS

* EXECUTE THE CODE FROM ADDRESS TO ADDRESS AND DISPLAY THE
* NUMBER OF CLOCK CYCLES REQUIRED.

 JSR CALCTIME
 BCC TSEXEC  ;IF THE COMMAND WAS OK
BPERR5 LDA #BADPAR  ;BAD COMMAND PARAMETERS ERROR NUMBER
TOERR5 JSR ERRBEEP  ;ERROR
 JMP GETCOMD
TSEXEC JSR TRANSFR5 ;EXECUTE USERS PROGRAM
 DFB EXECUTEC ;code

************** CALCTIME ************

CALCTIME
 PHA   ;SAVE CHARACTER
 LDA IERBUFF
 STA ETIERSAV ;SAVE VIAIER
 LDA VIAORA
 STA ETORASAV ;SAVE ORA & ORB
 LDA VIAORB
 STA ETORBSAV
 LDA PCLO
 STA ETPCLO  ;SAVE PC
 LDA PCHI
 STA ETPCHI
 PLA   ;GET CHARACTER
 JSR TRANSFR5 ;READ IN 2 ADDRESSES
 DFB CHKREADC ;code
 BCS ETERR  ;IF ERROR
 BIT ADDRS2F  ;2 ADDRESSES ENTERED ?
 BPL ETERR  ;IF NO
 STA PCLO  ;LOW BYTE OF 1ST ADDRESS
 LDA LETTER2  ;HI BYTE OF 1ST ADDRESS
 STA PCHI  ;REPLACE PC
 LDA LETTER4  ;LOW BYTE OF 2ND ADDRESS
 STA VIAORA
 LDA LETTER5  ;HI BYTE OF 2ND ADDRESS
 STA VIAORB  ;REPLACE HARD BREAK
 LDA #%10010000
 STA IERBUFF  ;ENABLE HARD BREAK
 STA ETFLAG  ;SET FLAG FOR NMIVEC ROUTINE

 LDA VIAACR
 AND #%11011111 ;SET T2 FOR TIMED INTERRUPT MODE
 STA VIAACR

*********** COUNTER PRESET ************

 LDA #$A7  ;BIGGER NUMBER MAKES ET SMALLER

 STA VIAT2CL  ;COUNTER PRESET
 LDA #ETVECTOR
 STA ENABLTVC
 LDA #>ETVECTOR ;SET UP NMI VECTOR
 STA ENABLTVC+1
 CLC
ETRTS RTS

ETERR JSR ETRESTOR ;RESTORE PC & VIA
 SEC
 RTS   ;USE CARRY BIT AS AN ERROR FLAG

* CONTINUATION OF ETVECTOR

ETVCONT LDA VIAT2CH  ;GET COUNTER VALUE
 EOR #$FF  ;ONES COMPLIMENT
 PHA
 LDA VIAT2CL
 EOR #$FF  ;ONES COMPLIMENT
 PHA   ;SAVE

* DISPLAY "CLOCK CYCLES = $" 

 JSR WRINIT5
:MORE LDA MSGET,Y  ;GET CHARACTER
 JSR WRITECK5 ;DISPLAY CHARACTER
 BCC :MORE  ;NOT FINISHED

 PLA
 TAX
 PLA
 JSR TRANSFR5 ;DISPLAY 4 DIGIT HEX COUNTER VALUE
 DFB PRNTAXC  ;CODE
 JSR ETRESTOR ;RESTORE PC & VIA
 LDA #0
 STA ETFLAG  ;CLEAR FLAG
 RTS   ;RETURN TO SEG 0 & MAIN10

* SUBROUTINES FOR CALCTIME

*RESTORE PC & VIA

ETRESTOR
 LDA ETPCLO
 STA PCLO
 LDA ETPCHI
 STA PCHI
 LDA ETORBSAV
 STA VIAORB
 LDA ETORASAV
 STA VIAORA
 LDA ETIERSAV
 STA IERBUFF  ;RESTORE IERBUFF
 RTS

******************************
* PART OF COMDTS

TSCONT BEQ :TSERR  ;IF NO
 JSR TRANSFR5 ;CHECK FOR HEX AND READ
 DFB CHKREADC ;CODE
 BCS :TSERR  ;IF NOT HEX
 STA SUBTRACE ;TO HI BYTE FOR (JUMP) VECTOR
 LDA LETTER2  ;HI BYTE Z
 STA SUBTRACE+1 ;TO LOW BYTE
 LDA #$80
 STA TSFLAG  ;SET FLAG
 CLC   ;CLEAR ERROR FLAG
 RTS   ;RETURN TO SEG0 & GOTO TRACEN

:TSERR SEC   ;SET ERROR FLAG
 RTS

*----------------------------------------
* Goto Pascal 1.1 routines in slot 1 or 2.
* Returns from slot space directly to calling routine.
* A, X, Y all trashed.
* Note !!! The following routine must always be called via TRANSFRx so that
* upon returning from the I/O routines the proper segment will be selected.

PASCALIO STA ASAVESEG ;save Acc
 LDA SLOTCN
 PHA
 LDA #EXTENAB-1
 PHA  ;return address for Pascal routines use
 LDA #$C2 ;default to slot 2
 BIT IOMODE ;bit 6=1 if slot1
 BVC :SLOT2
 LDA #$C1
:SLOT2 PHA  ;used by Pascal routine in simulated JSR

 LDA SLOTCN
 PHA
 LDA #TOPASCAL
 PHA
 LDA ASAVESEG ;restore Acc
 RTS ;goto slot space routine

********************
* BEEP AND INDICATE WHERE ERROR IS AND DISPLAY ERROR NUMBER

ERRBEEP
 PHA   ;SAVE ERROR NUMBER
 TYA
 BNE YNOTZER0
 LDA #1
YNOTZER0
 TAX   ;IF Y=0 THEN 256 SPACES PRINTED
 JSR TRANSFR5 ;PRINT SPACES
 DFB PRBL2C  ;CODE
 LDA #"^"
 JSR TRANSFR5 ;INDICATE WHERE ERROR WAS
 DFB COUTC  ;CODE
 JSR TRANSFR5 ;PRINT "ERR" RING BELL
 DFB PRERRC  ;CODE

 PLA   ;GET ERROR NUMBER
 JSR TRANSFR5 ;PRINT ERROR NUMBER
 DFB PRBYTEC  ;code
 RTS

*------------------------------------
* CHECK FOR ACCESS TO NO ACCESS RANGE
*------------------------------------

CKACCES
 BIT NOACCESS ;N RANGES ACTIVE ?
 BPL :END  ;IF NOT
 LDA TFLAG  ;TRACE MODE ?
 BEQ :END  ;IF NOT

 LDX #30
:CHECK LDA PROTADR,X ;GET PW TYPE
 CMP #"N"  ;IS IT NO ACCESS ?
 BNE :NEXT  ;IF NO
 JSR CHKRANG  ;IS PC IN RANGE ?
 BCS :IN  ;IF YES
 LDA NUMDISP  ;# BYTES IN INST-1
 BEQ :NEXT  ;ONE BYTE INSTR HAS NO EFF ADRS
 LDA MODE  ;# MODE ?
 BEQ :NEXT  ;# MODE NO EFF ADRS
* IS EFFADRS IN RANGE ?
 LDA PROTADR+1,X ;GET PBR
 CMP EFFADRS+2 ;COMPARE WITH EFF PBR
 BNE :NEXT  ;IF NOT IN RANGE
 LDA EFFADRS+1 ;EFF PCHI
 CMP PROTADR+2,X ;COMPARE WITH LOWER LIMIT PCHI
 BLT :NEXT  ;NOT IN RANGE
 BNE :CHKUP  ;CHECK UPPER LIMIT
 LDA EFFADRS  ;EFF PCLO
 CMP PROTADR+3,X ;COMPARE WITH LOWER LIMIT PCLO
 BLT :NEXT  ;NOT IN RANGE
 LDA EFFADRS+1 ;EFF PCHI
:CHKUP CMP PROTADR+4,X ;COMPARE WITH UPPER LIMIT PCHI
 BLT :IN  ;IN RANGE
 BNE :NEXT  ;NOT IN RANGE
 LDA EFFADRS  ;EFF PCLO
 CMP PROTADR+5,X ;COMPARE WITH UPPER LIMIT PCLO
 BLT :IN  ;IN RANGE
 BEQ :IN  ;IN RANGE
:NEXT SEC
 TXA   ;GOTO NEXT PROTADR
 SBC #6
 TAX
 BPL :CHECK
 BMI :END  ;NOT IN NO ACCESS RANGE

* IN NO ACCESS RANGE SO DISPLAY MESSAGE & STOP TRACE

:IN JSR TRANSFR5 ;DISPLAY "NO ACCESS HALT"
 DFB NOACMSGC ;code
 LDA #1  ;STOP TRACE
 STA TCOUNT+1
 LDA #0
 STA TCOUNT
:END RTS

* IS THE CURRENT PBR, PCHI, PCLO IN THIS PROT WINDOW LIMITS ?
* SEC IF YES

CHKRANG LDA PROTADR+1,X ;GET PBR
 CMP PBR
 BNE :NOTIN  ;NOT IN
 LDA PCHI
 CMP PROTADR+2,X ;COMPARE WITH LOWER LIMIT PCHI
 BLT :NOTIN  ;NOT IN
 BNE :CHKUP  ;CHECK UPPER LIMIT
 LDA PCLO
 CMP PROTADR+3,X ;COMPARE WITH LOWER LIMIT PCLOW
 BLT :NOTIN  ;IF NOT IN RANGE
 LDA PCHI

:CHKUP CMP PROTADR+4,X ;COMPARE WITH UPPER LIMIT PCHI
 BLT :IN  ;IF IN
 BNE :NOTIN  ;IF NOT IN
 LDA PCLO
 CMP PROTADR+5,X ;COMPARE WITH UPPER LIMIT PCLOW
 BLT :IN  ;IN RANGE
 BEQ :IN  ;INCLUSIVE
:NOTIN CLC
 RTS
:IN SEC
 RTS

*----------------------------------------
* Wait for 'return' or 'esc'
* returns C=0 on return, C=1 on esc

WAITCR
 JSR WRINIT5
:MORE LDA MSGCRES,Y ;GET CHAR
 JSR WRITECK5 ;DISPLAY
 BCC :MORE  ;<ALWAYS>

:WAIT JSR TRANSFR5 ;GET INPUT
 DFB RDCHARC ;code
 CMP #ESC ;was it 'esc' ?
 BEQ :EXIT ;if yes (C=1)
 CMP #CR ;was it 'return' ?
 BNE :WAIT ;if no
 CLC ;if yes (C=0)
:EXIT PHP ;save Carry
 JSR TRANSFR5 ;do carriage return
 DFB CROUTC ;code
 PLP ;restore Carry
 RTS

********* SAVE THE ACC,X AND P REGISTERS ********

SAVEAXP5
 PHP   ;SAVE STATUS
 STX XSAVESEG
 STA ASAVESEG
 PLA   ;GET STATUS
 STA PSAVESEG ;SAVE
 RTS

******** RESTORE THE ACC,X AND P REGISTERS *******

RESTAXP5
 LDX XSAVESEG
 LDA PSAVESEG
 PHA
 LDA ASAVESEG
 PLP
 RTS

***** GLOBAL SUBROUTINES IN THIS SEGMENT *****

SUBTABL5

GETCOMDC EQU *-SUBTABL5*4+5+$100
 DA GETCOMD-1

LISTC EQU *-SUBTABL5*4+5+$100
 DA LIST-1

ETVCONTC EQU *-SUBTABL5*4+5+$100
 DA ETVCONT-1

DISVERSC EQU *-SUBTABL5*4+5+$100
 DA DISVERS-1

COPYRC EQU *-SUBTABL5*4+5+$100
 DA COPYR-1

TSCONTC EQU *-SUBTABL5*4+5+$100
 DA TSCONT-1

ERRBEEPC EQU *-SUBTABL5*4+5+$100
 DA ERRBEEP-1

PASCALIOC EQU *-SUBTABL5*4+5+$100
 DA PASCALIO-1

CKACCESC EQU *-SUBTABL5*4+5+$100
 DA CKACCES-1

CHKRANGC EQU *-SUBTABL5*4+5+$100
 DA CHKRANG-1

WAITCRC EQU *-SUBTABL5*4+5+$100
 DA WAITCR-1

*****************************************
*  SEGMENT CROSSOVER AREA  *
*****************************************

 LST ON
S5END = $CF9D-*
 do nolist
 LST OFF
 fin
 ERR *-1/$CF9D
 DS $CF9D-*,$FF

*-------------------------------------------------
* Go to commands in other segments
JUMPSEG5
 LDA TEMP  ;SEG # OF COMMAND
 LDX SLOTN0
 NOP
 NOP   ;MAKE LENGTH MATCH OTHER SEGMENTS
 STA SEGMBASE,X ;THE NEXT INST' WILL BE IN NEW SEG
 JSR RESTAXP5 ;RESTORE AFTER XFER FROM OTHER SEG
 JMP GETCOMD

* TRANSFER TO OTHER SEGMENTS

TRANSFR5
 JSR SAVEAXP5
 PLA   ;GET RETRUN ADDRESS FROM STACK
 CLC
 ADC #1  ;INC TO POINT AT CODE BYTE
 STA TEMPSEG  ;SETUP LDA TEMPSEG ROUTINE
 PLA
 ADC #0  ;ADD CARRY, IF ANY
 STA TEMPSEG+1 ;SETUP LDA TEMPSEG ROUTINE
 PHA
 LDA TEMPSEG
 PHA   ;BUMP RETURN ADDRESS PAST CODE BYTE
 LDA #5  ;CURRENT SEG #
 PHA
 JSR LDATEMP  ;LOAD CODE BYTE
 STA SEGMCODE ;SAVE CODE
 AND #$07  ;STRIP ALL BUT SEG #
 LDX SLOTN0
 STA SEGMBASE,X ;NEXT INSTR. RUN FROM NEW SEGMENT
* NEW SEGMENT
 LDA #>RETURN5 ;WHERE TO RETURN TO
 PHA
 LDA #RETURN5
 PHA
 LDA SEGMCODE ;CODE BYTE
 AND #$F8  ;STRIP OFF SEG# LEAVING SUB #
 LSR
 LSR   ;LEAVE SUB# MULTIPLIED BY 2
* GET ADDRESS OF SUB FROM SUBTABL & PUSH ON STACK
 TAX
 LDA SUBTABL5+1,X ;HI BYTE FIRST
 PHA
 LDA SUBTABL5,X
 PHA

 JSR RESTAXP5 ;RESTORE REGISTERS
 RTS   ;USE RTS TO GOTO SUB

* RETURN HERE FROM SUBROUTINE

RETURN5 EQU *-1
 JSR SAVEAXP5
 PLA   ;SEG # TO RETURN TO
 LDX SLOTN0
 STA SEGMBASE,X ;RETURN TO SEGMENT
 JSR RESTAXP5
 RTS   ;RETURN TO CALLING PROGRAM

 DS \,$FF ;PUT OBJECT AT NEXT PAGE
